home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / psd.zip / COMINT.EL < prev    next >
Text File  |  1992-07-10  |  49KB  |  1,129 lines
  1. ;To: unix-emacs@bbn.com
  2. ;Date: 9 Feb 89 21:25:28 GMT
  3. ;From: Olin Shivers <centro.soar.cs.cmu.edu!shivers@pt.cs.cmu.edu>
  4. ;Subject: New process modes for shell, Lisp, Scheme, T, TeX (part 1 of 3)
  5. ;
  6. ;1. The standard anouncement header
  7. ;2. The source for comint.el
  8. ;(The entire package must be split -- otherwise notesfiles sites will not
  9. ;be able to handle it.)
  10. ;-------------------------------------------------------------------------------
  11. ;I have written new gnu-emacs packages that provide shell, inferior lisp,
  12. ;inferior scheme, and inferior T modes. These packages have the following
  13. ;advantages over the standard released gnu packages:
  14. ;
  15. ;- Input history is kept in all modes, traversed with M-p and M-n, just
  16. ;  like on LispM's and various fancy shells.
  17. ;- Filename completion and query is available in all modes.
  18. ;- Keybindings are cross-compatible among all modes.
  19. ;- Keybindings are compatible with Zwei and Hemlock.
  20. ;- Directory tracking is more robust in shell mode, and is *only* active in
  21. ;  shell mode. (Try entering "cd /" to an inferior lisp in the old package:
  22. ;  Lisp barfs, but the inferior lisp mode goes ahead and changes the 
  23. ;  buffer's directory.)
  24. ;- Non-echoed text entry (for entering passwords) is available in all modes.
  25. ;- Shell and inferior Lisp modes are backwards compatible with the standard
  26. ;  gnu modes.
  27. ;- One source for the inferior Lisp mode works in both emacs releases 18.4x and 
  28. ;  18.5x. This has been the cause of confusing bugs for users who unwittingly
  29. ;  tried to use an 18.4x version inferior Lisp mode in an 18.5x version emacs,
  30. ;  and vice-versa.
  31. ;- A full set of eval/compile-region/defun commands for the inferior Lisp,
  32. ;  Scheme, and T modes.
  33. ;- New modes are easily created for new types of processes.
  34. ;===============================================================================
  35. ;
  36. ;THE BAD NEWS:
  37. ;It would be nice if the shell & inferior lisp package, cmushell.el, was
  38. ;completely plug-compatible with the old package in shell.el -- if you could
  39. ;just name the new version shell.el, and have it transparently replace the old
  40. ;one. But you can't.  Several other packages (tex-mode, background, dbx, gdb,
  41. ;kermit, monkey, prolog, telnet) are also clients of shell mode. These packages
  42. ;assume detailed knowledge of shell mode internals in ways that are
  43. ;incompatible with the new mode (mostly because of the new mode's greater
  44. ;functionality).  So, unless we are willing to port all of these packages, we
  45. ;can't have the new shell package be a complete replacement for shell.el --
  46. ;that is, we can't name the file shell.el, and its main entry point (shell),
  47. ;because dbx.el will break when it loads it in and tries to use it.
  48. ;
  49. ;There are two ways to fix this. One: rewrite these other modes to use the
  50. ;new package. This is a win, but can't be assumed. The other, backwards
  51. ;compatible route, is to make this package non-conflict with shell.el, so
  52. ;both files can be loaded in at the same time. This is what I have 
  53. ;done. So the mode names and major functions have different names, e.g:
  54. ;    shell.el        cmushell.el
  55. ;    --------        ----------
  56. ;    M-x shell       M-x cmushell        -- Fire up a shell
  57. ;    M-x run-lisp    M-x cmulisp         -- Fire up a lisp
  58. ;    shell-mode-map      cmushell-mode-map   -- Keybindings for [cmu]shell mode
  59. ;All the names have been carefully chosen so that shell.el and cmushell.el 
  60. ;won't tromp on each other -- that way dbx.el and friends can happily load
  61. ;in shell.el without breaking the cmushell.el package, and vice versa.
  62. ;
  63. ;With the exception of M-x cmushell and M-x cmulisp, however, most of the name
  64. ;changes are invisible to the user. Further, most of the customising 
  65. ;variables that are common in functionality have the same name:
  66. ;    inferior-lisp-program, explicit-shell-file-name, et al.
  67. ;Hook variables are different, so you can customise shell-mode and 
  68. ;cmushell-mode differently, for instance.
  69. ;
  70. ;By the way, it is rather easy to port the shell.el-dependent packages to use
  71. ;the new stuff.  There are fairly complete comments in the relevant source
  72. ;files showing how to do this.  Note that this backwards-compatibility hassle
  73. ;*only* affects shell and inferior lisp mode; the other process-in-a-buffer
  74. ;modes (Scheme, T, etc.) do not have this problem.
  75. ;===============================================================================
  76. ;
  77. ;GENERALIA:
  78. ;The implementation strategy was to factor common process functionality
  79. ;into a general command interpreter mode -- comint mode -- and then to
  80. ;build all the specific modes on top. This provides uniform, integrated
  81. ;functionality and interface across all the derived modes. Comint mode
  82. ;provides the input history, filename completion and query,
  83. ;non-echoed text entry, input editing, and process signalling 
  84. ;(e.g., ^z, ^c, ...) commands. *Any* mode built on comint mode gets
  85. ;all this stuff automatically. Additionally, comint mode has general
  86. ;hooks for customising it to specific command interpreters, such as
  87. ;Lisp, Scheme, csh, ML, etc..
  88. ;
  89. ;This release includes the following files:
  90. ;- comint.el     comint mode
  91. ;- cmushell.el    cmushell and cmulisp modes, built on comint mode.
  92. ;- cmuscheme.el  inferior Scheme mode, built on comint mode.
  93. ;- tea.el        inferior T mode, built on comint mode.
  94. ;- tea2.el       Variant of tea.el
  95. ;- cmutex.el     tex-mode.el with rewritten process interaction code.
  96. ;                Some bugs also fixed.
  97. ;
  98. ;These packages have been in daily use by a user community of about 10-20
  99. ;at CMU since August; most bugs have been shaken out. cmutex.el is less
  100. ;tested. Please notify me of bugs.
  101. ;
  102. ;The files are *extensively* commented; this should serve as sufficient
  103. ;documentation. Each file includes suggestions for your .emacs file
  104. ;in comments at the top. On-line documentation (C-h C-m, C-h C-f, C-h C-v)
  105. ;is available for modes, commands, and variables.
  106. ;
  107. ;This source is available on an FSF-style basis: use it any way you like
  108. ;as long as you don't charge money for it or change the basis of its
  109. ;availability; I assume no liability for its use.
  110. ;===============================================================================
  111. ;
  112. ;INPUT HISTORY:
  113. ;There are actually two different ways to retrieve old commands for
  114. ;resubmission to a process. The standard way is to use the input history
  115. ;mechanism. An internal list is kept in each process buffer of the last n
  116. ;inputs (default: 30). The commands M-p and M-n move through this list.  This
  117. ;is similar in functionality to the input history mechanisms provided by the
  118. ;LispM, Hemlock, and various fancy shells (tcsh, cmucsh, ksh,...).  There is
  119. ;also a command, bound to C-c r, which searches backwards through the input
  120. ;history looking for a substring match.
  121. ;
  122. ;RMS doesn't like this mechanism. He has suggested an input history mechanism
  123. ;that operates by searching backwards (and forwards) through the buffer for
  124. ;occurrences of the prompt.  The user can then resubmit the input by hitting
  125. ;return.
  126. ;
  127. ;I do not like this mechanism. If the prompt changes dynamically, you can miss
  128. ;a command. False positives are also annoying. The screen jumps around a lot as
  129. ;you scroll through your history. If you run a subprogram that has a null
  130. ;prompt (like dc), prompt search will miss all its inputs. Etc.
  131. ;
  132. ;However, you may try either of these mechanisms, and go with the style you
  133. ;prefer. The RMS-style prompt-search stuff is available on M-N and M-P
  134. ;(meta-shift-n and meta-shift-P); C-c R is bound to a command that searches for
  135. ;specific commands (analogous to C-c r). If you use this stuff, you will
  136. ;probably want to sharpen up the regular expression used to match the prompt in
  137. ;each mode to match your particular prompt -- the default, general regexp used
  138. ;in shell mode generates too many annoying false positives.  (It's local
  139. ;variable comint-prompt-regexp -- you should set it in a hook).
  140. ;===============================================================================
  141. ;
  142. ;Source code follows. Please report bugs to me: shivers@cs.cmu.edu.
  143. ;    -Olin
  144. ;------
  145. ;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
  146. ;;; Copyright Olin Shivers (1988).
  147. ;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
  148. ;;; notice appearing here to the effect that you may use this code any
  149. ;;; way you like, as long as you don't charge money for it, remove this
  150. ;;; notice, or hold me liable for its results.
  151.  
  152. ;;; This hopefully generalises shell mode, lisp mode, tea mode, soar mode,...
  153. ;;; Hacked from tea.el and shell.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
  154.  
  155. ;;; This file defines a general command-interpreter-in-a-buffer package
  156. ;;; (comint mode). The idea is that you can build specific process-in-a-buffer
  157. ;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
  158. ;;; This way, all these specific packages share a common base functionality, 
  159. ;;; and a common set of bindings, which makes them easier to use (and
  160. ;;; saves code, implementation time, etc., etc.).
  161. ;;; 
  162. ;;; Several packages are already defined using comint mode:
  163. ;;; - The file cmushell.el defines cmushell and cmulisp mode.
  164. ;;; Cmushell and cmulisp mode are similar to, and intended to replace,
  165. ;;; their counterparts in the standard gnu emacs release (in shell.el). 
  166. ;;; These replacements are more featureful, robust, and uniform than the 
  167. ;;; released versions. The key bindings in lisp mode are also more compatible
  168. ;;; with the bindings of Hemlock and Zwei (the Lisp Machine emacs).
  169. ;;;
  170. ;;; - The file cmuscheme.el defines inferior-scheme mode.
  171. ;;; - The file tea.el tunes scheme and inferior-scheme modes for T.
  172. ;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
  173.  
  174. ;;; For documentation on the functionality provided by comint mode, and
  175. ;;; the hooks available for customising it, see the comments below.
  176. ;;; For further information on the standard derived modes (shell, 
  177. ;;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
  178.  
  179. ;;; Please send me bug reports, bug fixes, and extensions, so that I can
  180. ;;; merge them into the master source.
  181.  
  182. ;;; For hints on converting existing process modes (e.g., tex-mode,
  183. ;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
  184. ;;; instead of shell-mode, see the notes at the end of this file.
  185.  
  186. (provide 'comint)
  187.  
  188.  
  189. ;;; Brief Command Documentation:
  190. ;;;============================================================================
  191. ;;; Comint Mode Commands: (common to all derived modes, like cmushell & cmulisp
  192. ;;; mode)
  193. ;;;
  194. ;;; m-p        comint-previous-input            Cycle backwards in input history
  195. ;;; m-n        comint-next-input                  Cycle forwards
  196. ;;; c-c r   comint-previous-input-matching  Search backwards in input history
  197. ;;; return  comint-send-input
  198. ;;; c-a     comint-bol                      Beginning of line; skip prompt.
  199. ;;; c-d        comint-delchar-or-maybe-eof     Delete char unless at end of buff.
  200. ;;; c-c c-u comint-kill-input                ^u
  201. ;;; c-c c-w backward-kill-word            ^w
  202. ;;; c-c c-c comint-interrupt-subjob         ^c
  203. ;;; c-c c-z comint-stop-subjob                ^z
  204. ;;; c-c c-\ comint-quit-subjob                ^\
  205. ;;; c-c c-o comint-kill-output            Delete last batch of process output
  206. ;;; c-c c-r comint-show-output            Show last batch of process output
  207. ;;;
  208. ;;; Not bound by default in comint-mode
  209. ;;; send-invisible            Read a line w/o echo, and send to proc
  210. ;;; (These are bound in shell-mode)
  211. ;;; comint-dynamic-complete        Complete filename at point.
  212. ;;; comint-dynamic-list-completions    List completions in help buffer.
  213. ;;; comint-replace-by-expanded-filename    Expand and complete filename at point;
  214. ;;;                    replace with expanded/completed name.
  215. ;;; comint-kill-subjob            No mercy.
  216. ;;; comint-continue-subjob        Send CONT signal to buffer's process
  217. ;;;                    group. Useful if you accidentally
  218. ;;;                    suspend your process (with C-c C-z).
  219. ;;;
  220. ;;; Bound for RMS -- I prefer the input history stuff, but you might like 'em.
  221. ;;; m-P       comint-msearch-input        Search backwards for prompt
  222. ;;; m-N    comint-psearch-input        Search forwards for prompt
  223. ;;; C-cR   comint-msearch-input-matching Search backwards for prompt & string
  224.  
  225. ;;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
  226. ;;; comint-load-hook is run after loading in this package.
  227.  
  228.  
  229. ;;; Buffer Local Variables:
  230. ;;;============================================================================
  231. ;;; Comint mode buffer local variables:
  232. ;;;     comint-prompt-regexp    - string       comint-bol uses to match prompt.
  233. ;;;     comint-last-input-end   - marker       For comint-kill-output command
  234. ;;;     input-ring-size         - integer      For the input history
  235. ;;;     input-ring              - ring             mechanism
  236. ;;;     input-ring-index        - marker           ...
  237. ;;;     comint-last-input-match - string           ...
  238. ;;;     comint-get-old-input    - function     Hooks for specific 
  239. ;;;     comint-input-sentinel   - function         process-in-a-buffer
  240. ;;;     comint-input-filter     - function         modes.
  241. (defvar comint-prompt-regexp "^"
  242.   "Regexp to recognise prompts in the inferior process.
  243. Defaults to \"^\", the null string at BOL.
  244.  
  245. Good choices:
  246.   Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
  247.   Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
  248.   franz: \"^\\(->\\|<[0-9]*>:\\) *\"
  249.   kcl: \"^>+ *\"
  250.   shell: \"^[^#$%>]*[#$%>] *\"
  251.   T: \"^>+ *\"
  252.  
  253. This is a good thing to set in mode hooks.")
  254.  
  255. (defvar input-ring-size 30
  256.   "Size of input history ring.")
  257.  
  258. ;;;(Here are the per-interpreter hooks.
  259. (defvar comint-get-old-input (function comint-get-old-input-default)
  260.   "Function that submits old text in comint mode.
  261. This function is called when return is typed while the point is in old text.
  262. It returns the text to be submitted as process input.  The default is
  263. comint-get-old-input-default, which grabs the current line, and strips off
  264. leading text matching comint-prompt-regexp")
  265.  
  266. (defvar comint-input-sentinel (function ignore)
  267.   "Called on each input submitted to comint mode process by comint-send-input.
  268. Thus it can, for instance, track cd/pushd/popd commands issued to the csh.")
  269.  
  270. (defvar comint-input-filter
  271.   (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
  272.   "Predicate for filtering additions to input history.
  273. Only inputs answering true to this function are saved on the input
  274. history list. Default is to save anything that isn't all whitespace")
  275.  
  276. (defvar comint-mode-hook '()
  277.   "Called upon entry into comint-mode")
  278.  
  279. (defvar comint-mode-map nil)
  280.  
  281. (defun comint-mode ()
  282.   "Major mode for interacting with an inferior interpreter.
  283. Interpreter name is same as buffer name, sans the asterisks.
  284. Return at end of buffer sends line as input.
  285. Return not at end copies rest of line to end and sends it.
  286.  
  287. This mode is typically customised to create inferior-lisp-mode,
  288. shell-mode, etc.. This can be done by setting the hooks
  289. comint-input-sentinel, comint-input-filter, and comint-get-old-input to
  290. appropriate functions, and the variable comint-prompt-regexp to
  291. the appropriate regular expression.
  292.  
  293. An input history is maintained of size input-ring-size, and
  294. can be accessed with the commands comint-next-input [\\[comint-next-input]] and 
  295. comint-previous-input [\\[comint-previous-input]]. Commands not keybound by
  296. default are send-invisible, comint-dynamic-complete, and 
  297. comint-list-dynamic-completions.
  298. \\{comint-mode-map}
  299. If you accidentally suspend your process, use \\[comint-continue-subjob]
  300. to continue it.
  301.  
  302. Entry to this mode runs the hooks on comint-mode-hook"
  303.   (interactive)
  304.   (let ((old-ring (and (assq 'input-ring (buffer-local-variables))
  305.                (boundp 'input-ring)
  306.                input-ring)))
  307.     (kill-all-local-variables)
  308.     (setq major-mode 'comint-mode)
  309.     (setq mode-name "Comint")
  310.     (setq mode-line-process '(": %s"))
  311.     (use-local-map comint-mode-map)
  312.     (make-local-variable 'comint-last-input-end)
  313.     (setq comint-last-input-end (make-marker))
  314.     (make-local-variable 'comint-last-input-match)
  315.     (setq comint-last-input-match "")
  316.     (make-variable-buffer-local 'comint-prompt-regexp) ; Don't set; default
  317.     (make-variable-buffer-local 'input-ring-size)      ; ...to global val.
  318.     (make-local-variable 'input-ring)
  319.     (make-local-variable 'input-ring-index)
  320.     (setq input-ring-index 0)
  321.     (make-variable-buffer-local 'comint-get-old-input)
  322.     (make-variable-buffer-local 'comint-input-sentinel)
  323.     (make-variable-buffer-local 'comint-input-filter)  
  324.     (run-hooks 'comint-mode-hook)
  325.     ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
  326.     ;The test is so we don't lose history if we run comint-mode twice in
  327.     ;a buffer.
  328.     (setq input-ring (if (ring-p old-ring) old-ring
  329.              (make-ring input-ring-size)))))
  330.  
  331. (if comint-mode-map
  332.     nil
  333.   (setq comint-mode-map (make-sparse-keymap))
  334.   (define-key comint-mode-map "\ep" 'comint-previous-input)
  335.   (define-key comint-mode-map "\en" 'comint-next-input)
  336.   (define-key comint-mode-map "\C-m" 'comint-send-input)
  337.   (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
  338.   (define-key comint-mode-map "\C-a" 'comint-bol)
  339.   (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
  340.   (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
  341.   (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
  342.   (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
  343.   (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
  344.   (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
  345.   (define-key comint-mode-map "\C-cr"    'comint-previous-input-matching)
  346.   (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
  347.   ;;; Here's the prompt-search stuff I installed for RMS to try...
  348.   (define-key comint-mode-map "\eP" 'comint-msearch-input)
  349.   (define-key comint-mode-map "\eN" 'comint-psearch-input)
  350.   (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching))
  351.  
  352.  
  353. ;;; This function is used to make a full copy of the comint mode map,
  354. ;;; so that client modes won't interfere with each other. This function
  355. ;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions.
  356. (defun full-copy-sparse-keymap (km)
  357.   "Recursively copy the sparse keymap KM"
  358.   (cond ((consp km)
  359.      (cons (full-copy-sparse-keymap (car km))
  360.            (full-copy-sparse-keymap (cdr km))))
  361.     (t km)))
  362.  
  363. (defun comint-check-proc (buffer-name)
  364.   "True if there is a process associated w/buffer BUFFER-NAME, and
  365. it is alive (status RUN or STOP)."
  366.   (let ((proc (get-buffer-process buffer-name)))
  367.     (and proc (memq (process-status proc) '(run stop)))))
  368.  
  369. ;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
  370. ;;; for the second argument (program).
  371. (defun make-comint (name program &optional startfile &rest switches)
  372.   (let* ((buffer (get-buffer-create (concat "*" name "*")))
  373.      (proc (get-buffer-process buffer)))
  374.     ;; If no process, or nuked process, crank up a new one and put buffer in
  375.     ;; comint mode. Otherwise, leave buffer and existing process alone.
  376.     (cond ((or (not proc) (not (memq (process-status proc) '(run stop))))
  377.        (comint-exec buffer name program startfile switches)
  378.        (save-excursion
  379.          (set-buffer buffer)
  380.          (comint-mode)))) ; Install local vars, mode, keymap, ...
  381.     buffer))
  382.  
  383. (defun comint-exec (buffer name command startfile switches)
  384.   "Fires up a process in buffer for comint modes.
  385. Blasts any old process running in the buffer. Doesn't set the buffer mode.
  386. You can use this to cheaply run a series of processes in the same comint
  387. buffer."
  388.   (save-excursion
  389.     (set-buffer buffer)
  390.     (let ((proc (get-buffer-process buffer)))    ; Blast any old process.
  391.       (if proc (delete-process proc)))
  392.     ;; Crank up a new process
  393.     (let ((proc (apply 'start-process name buffer (concat exec-directory "env")
  394.                (format "TERMCAP=emacs:co#%d:tc=unknown:"
  395.                    (screen-width))
  396.                "TERM=emacs" "EMACS=t" "-" command switches)))
  397.       ;; Feed it the startfile.
  398.       (cond (startfile
  399.          ;;This is guaranteed to wait long enough
  400.          ;;but has bad results if the comint does not prompt at all
  401.          ;;         (while (= size (buffer-size))
  402.          ;;           (sleep-for 1))
  403.          ;;I hope 1 second is enough!
  404.          (sleep-for 1)
  405.          (goto-char (point-max))
  406.          (insert-file-contents startfile)
  407.          (setq startfile (buffer-substring (point) (point-max)))
  408.          (delete-region (point) (point-max))
  409.          (process-send-string proc startfile)))
  410.       ;; Jump to the end, and set the process mark.
  411.       (goto-char (point-max))
  412.       (set-marker (process-mark proc) (point)))
  413.     buffer))
  414.       
  415.  
  416.  
  417. ;;; Ring Code
  418. ;;;============================================================================
  419. ;;; This code dmfines a ring data structure. A ring is a 
  420. ;;;     (hd-index tl-index . vector) 
  421. ;;; list. You can insert to, remove from, and rotate a ring. When the ring
  422. ;;; fills up, insertions cause the oldest elts to be quietly dropped.
  423. ;;;
  424. ;;; HEAD = index of the newest item on the ring.
  425. ;;; TAIL = index of the oldest item on the ring.
  426. ;;;
  427. ;;; These functions are used by the input history mechanism, but they can
  428. ;;; be used for other purposes as well.
  429.  
  430. (defun ring-p (x) 
  431.   "T if X is a ring; NIL otherwise."
  432.   (and (consp x) (integerp (car x))
  433.        (consp (cdr x)) (integerp (car (cdr x)))
  434.        (vectorp (cdr (cdr x)))))
  435.  
  436. (defun make-ring (size)
  437.   "Make a ring that can contain SIZE elts"
  438.   (cons 1 (cons 0 (make-vector (+ size 1) nil))))
  439.  
  440. (defun ring-plus1 (index veclen)
  441.   "INDEX+1, with wraparound"
  442.   (let ((new-index (+ index 1)))
  443.     (if (= new-index veclen) 0 new-index)))
  444.  
  445. (defun ring-minus1 (index veclen)
  446.   "INDEX-1, with wraparound"
  447.   (- (if (= 0 index) veclen index) 1))
  448.  
  449. (defun ring-length (ring)
  450.   (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
  451.     (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
  452.       (if (= len siz) 0 len))))
  453.  
  454. (defun ring-empty-p (ring)
  455.   (= 0 (ring-length ring)))
  456.  
  457. (defun ring-insert (ring item)
  458.   "Insert a new item onto the ring. If the ring is full, dump the oldest
  459. item to make room."       
  460.   (let* ((vec (cdr (cdr ring)))  (len (length vec))
  461.      (new-hd (ring-minus1 (car ring) len)))
  462.       (setcar ring new-hd)
  463.       (aset vec new-hd item)
  464.       (if (ring-empty-p ring) ;overflow -- dump one off the tail.
  465.       (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
  466.  
  467. (defun ring-remove (ring)
  468.   "Remove the oldest item retained on the ring."
  469.   (if (ring-empty-p ring) (error "Ring empty")
  470.       (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  471.     (set-car (cdr ring) (ring-minus1 tl (length vec)))
  472.     (aref vec tl))))
  473.  
  474. ;;; This isn't actually used in this package. I just threw it in in case
  475. ;;; someone else wanted it. If you want rotating-ring behavior on your history
  476. ;;; retrieval (analagous to kill ring behavior), this function is what you
  477. ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with
  478. ;;; this, and not bind it to a key by default, so it would be available to
  479. ;;; people who want to bind it to a key. But who would want it? Blech.
  480. (defun ring-rotate (ring n)
  481.   (if (not (= n 0))
  482.       (if (ring-empty-p ring) ;Is this the right error check?
  483.       (error "ring empty")
  484.       (let ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  485.         (let ((len (length vec)))
  486.           (while (> n 0)
  487.         (setq tl (ring-plus1 tl len))
  488.         (aset ring tl (aref ring hd))
  489.         (setq hd (ring-plus1 hd len))
  490.         (setq n (- n 1)))
  491.           (while (< n 0)
  492.         (setq hd (ring-minus1 hd len))
  493.         (aset vec hd (aref vec tl))
  494.         (setq tl (ring-minus1 tl len))
  495.         (setq n (- n 1))))
  496.         (set-car ring hd)
  497.         (set-car (cdr ring) tl)))))
  498.  
  499. (defun comint-mod (n m)
  500.   "Returns N mod M. M is positive. Answer is guaranteed to be non-negative, 
  501. and less than m."
  502.   (let ((n (% n m)))
  503.     (if (>= n 0) n
  504.     (+ n
  505.        (if (>= m 0) m (- m)))))) ; (abs m)
  506.  
  507. (defun ring-ref (ring index)
  508.   (let ((numelts (ring-length ring)))
  509.     (if (= numelts 0) (error "indexed empty ring")
  510.     (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
  511.            (index (comint-mod index numelts))
  512.            (vec-index (comint-mod (+ index hd) 
  513.                       (length vec))))
  514.       (aref vec vec-index)))))
  515.  
  516.  
  517. ;;; Input history retrieval commands
  518. ;;; M-p -- previous input    M-n -- next input
  519. ;;; C-c r -- previous input matching
  520. ;;; ===========================================================================
  521.  
  522. (defun comint-previous-input (arg)
  523.   "Cycle backwards through input history."
  524.   (interactive "*p")
  525.   (let ((len (ring-length input-ring)))
  526.     (cond ((<= len 0)
  527.        (message "Empty input ring")
  528.        (ding))
  529.       ((not (comint-after-pmark-p))
  530.        (message "Not after process mark")
  531.        (ding))
  532.       (t
  533.        (cond ((eq last-command 'comint-previous-input)
  534.           (delete-region (mark) (point))
  535.           (set-mark (point)))
  536.          (t                          
  537.           (setq input-ring-index
  538.             (if (> arg 0) -1
  539.                 (if (< arg 0) 1 0)))
  540.           (push-mark (point))))
  541.        (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
  542.        (message "%d" (1+ input-ring-index))
  543.        (insert (ring-ref input-ring input-ring-index))
  544.        (setq this-command 'comint-previous-input))
  545.       (t (ding)))))
  546.      
  547. (defun comint-next-input (arg)
  548.   "Cycle forwards through input history."
  549.   (interactive "*p")
  550.   (comint-previous-input (- arg)))
  551.  
  552. (defvar comint-last-input-match ""
  553.   "Last string searched for by comint input history search, for defaulting.
  554. Buffer local variable.") 
  555.  
  556. (defun comint-previous-input-matching (str)
  557.   "Searches backwards through input history for substring match"
  558.   (interactive (let ((s (read-from-minibuffer 
  559.              (format "Command substring (default %s): "
  560.                  comint-last-input-match))))
  561.          (list (if (string= s "") comint-last-input-match s))))
  562. ; (interactive "sCommand substring: ")
  563.   (setq comint-last-input-match str) ; update default
  564.   (let ((str (regexp-quote str))
  565.         (len (ring-length input-ring))
  566.     (n 0))
  567.     (while (and (<= n len) (not (string-match str (ring-ref input-ring n))))
  568.       (setq n (+ n 1)))
  569.     (cond ((<= n len) (comint-previous-input (+ n 1)))
  570.       (t (error "Not found.")))))
  571.  
  572. ;;; These next three commands are alternatives to the input history commands --
  573. ;;; comint-next-input, comint-previous-input and 
  574. ;;; comint-previous-input-matching. They search through the process buffer
  575. ;;; text looking for occurrences of the prompt. RMS likes them better;
  576. ;;; I don't. Bound to M-P, M-N, and C-c R (uppercase P, N, and R) for
  577. ;;; now. Try'em out. Go with what you like...
  578.  
  579. ;;; comint-msearch-input-matching prompts for a string, not a regexp.
  580. ;;; This could be considered to be the wrong thing. I decided to keep it
  581. ;;; simple, and not make the user worry about regexps. This, of course,
  582. ;;; limits functionality.
  583.  
  584. (defun comint-psearch-input ()
  585.   "Search forwards for next occurrence of prompt and skip to end of line.
  586. \(prompt is anything matching regexp comint-prompt-regexp)"
  587.   (interactive)
  588.   (if (re-search-forward comint-prompt-regexp (point-max) t)
  589.       (end-of-line)
  590.       (error "No occurrence of prompt found")))
  591.  
  592. (defun comint-msearch-input ()
  593.   "Search backwards for previous occurrence of prompt and skip to end of line.
  594. Search starts from beginning of current line."
  595.   (interactive)
  596.   (let ((p (save-excursion
  597.          (beginning-of-line)
  598.          (cond ((re-search-backward comint-prompt-regexp (point-min) t)
  599.             (end-of-line)
  600.             (point))
  601.            (t nil)))))
  602.     (if p (goto-char p)
  603.     (error "No occurrence of prompt found"))))
  604.  
  605. (defun comint-msearch-input-matching (str)
  606.   "Search backwards for occurrence of prompt followed by STRING.
  607. STRING is prompted for, and is NOT a regular expression."
  608.   (interactive (let ((s (read-from-minibuffer 
  609.              (format "Command (default %s): "
  610.                  comint-last-input-match))))
  611.          (list (if (string= s "") comint-last-input-match s))))
  612. ; (interactive "sCommand: ")
  613.   (setq comint-last-input-match str) ; update default
  614.   (let* ((r (concat comint-prompt-regexp (regexp-quote str)))
  615.      (p (save-excursion
  616.           (beginning-of-line)
  617.           (cond ((re-search-backward r (point-min) t)
  618.              (end-of-line)
  619.              (point))
  620.             (t nil)))))
  621.     (if p (goto-char p)
  622.     (error "No match"))))
  623.  
  624. (defun comint-send-input () 
  625.   "Send input to process.  After the process output mark, sends all text
  626. from the process mark to point as input to the process.  Before the
  627. process output mark, calls value of variable comint-get-old-input to retrieve
  628. old input, copies it to the end of the buffer, and sends it.  A terminal
  629. newline is also inserted into the buffer and sent to the process.  In either
  630. case, value of variable comint-input-sentinel is called on the input before
  631. sending it.  The input is entered into the input history ring, if value of
  632. variable comint-input-filter returns T when called on the input.
  633.  
  634. comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen
  635. according to the command interpreter running in the buffer. E.g.,
  636. If the interpretmr is the csh,
  637.     comint-get-old-input is the default: take the current line, discard any
  638.         initial string matching regexp comint-prompt-regexp.
  639.     comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" 
  640.         commands. When it sees one, it cd's the buffer.
  641.     comint-input-filter is the default: returns T if the input isn't all white
  642.     space.
  643.  
  644. If the comint is Lucid Common Lisp, 
  645.     comint-get-old-input snarfs the sexp ending at point.
  646.     comint-input-sentinel does nothing.
  647.     comint-input-filter returns NIL if the input matches input-filter-regexp,
  648.         which matches (1) all whitespace (2) :a, :c, etc.
  649.  
  650. Similarly for Soar, Scheme, etc.."
  651.   (interactive)
  652.   ;; Note that the input string does not include its terminal newline.
  653.   (let ((proc (get-buffer-process (current-buffer))))
  654.     (if (not proc) (error "Current buffer has no process")
  655.     (let* ((pmark (process-mark proc))
  656.            (pmark-val (marker-position pmark))
  657.            (input (if (>= (point) pmark-val)
  658.               (buffer-substring pmark (point))
  659.               (let ((copy (funcall comint-get-old-input)))
  660.                 (goto-char pmark)
  661.                 (insert copy)
  662.                 copy))))
  663.       (insert ?\n)
  664.       (if (funcall comint-input-filter input) (ring-insert input-ring input))
  665.       (funcall comint-input-sentinel input)
  666.       (process-send-string proc input)
  667.       (process-send-string proc "\n")
  668.       (set-marker (process-mark proc) (point))
  669.       (set-marker comint-last-input-end (point))))))
  670.  
  671. (defun comint-get-old-input-default ()
  672.   "Default for comint-get-old-input: take the current line, and discard
  673. any initial text matching comint-prompt-regexp."
  674.   (save-excursion
  675.     (beginning-of-line)
  676.     (comint-skip-prompt)
  677.     (let ((beg (point)))
  678.       (end-of-line)
  679.       (buffer-substring beg (point)))))
  680.  
  681. (defun comint-skip-prompt ()
  682.   "Skip past the text matching regexp comint-prompt-regexp. 
  683. If this takes us past the end of the current line, don't skip at all."
  684.   (let ((eol (save-excursion (end-of-line) (point))))
  685.     (if (and (looking-at comint-prompt-regexp)
  686.          (<= (match-end 0) eol))
  687.     (goto-char (match-end 0)))))
  688.  
  689.  
  690. (defun comint-after-pmark-p ()
  691.   "Is point after the process output marker?"
  692.   ;; Since output could come into the buffer after we looked at the point
  693.   ;; but before we looked at the process marker's value, we explicitly 
  694.   ;; serialise. This is just because I don't know whether or not emacs
  695.   ;; services input during execution of lisp commands.
  696.   (let ((proc-pos (marker-position
  697.            (process-mark (get-buffer-process (current-buffer))))))
  698.     (<= proc-pos (point))))
  699.  
  700. (defun comint-bol (arg)
  701.   "Goes to the beginning of line, then skips past the prompt, if any.
  702. If a prefix argument is given (\\[universal-argument]), then no prompt skip 
  703. -- go straight to column 0.
  704.  
  705. The prompt skip is done by skipping text matching the regular expression
  706. comint-prompt-regexp, a buffer local variable.
  707.  
  708. If you don't like this command, reset c-a to beginning-of-line 
  709. in your hook, comint-mode-hook."
  710.   (interactive "P")
  711.   (beginning-of-line)
  712.   (if (null arg) (comint-skip-prompt)))
  713.  
  714. ;;; These two functions are for entering text you don't want echoed or
  715. ;;; saved -- typically passwords to ftp, telnet, or somesuch.
  716. ;;; Just enter m-x send-invisible and type in your line.
  717.  
  718. (defun comint-read-noecho (prompt)
  719.   "Prompt the user with argument PROMPT. Read a single line of text
  720. without echoing, and return it. Note that the keystrokes comprising
  721. the text can still be recovered (temporarily) with \\[view-lossage]. This
  722. may be a security bug for some applications."
  723.   (let ((echo-keystrokes 0)
  724.     (answ "")
  725.     tem)
  726.     (if (and (stringp prompt) (not (string= (message prompt) "")))
  727.     (message prompt))
  728.     (while (not(or  (= (setq tem (read-char)) ?\^m)
  729.             (= tem ?\n)))
  730.       (setq answ (concat answ (char-to-string tem))))
  731.     (message "")
  732.     answ))
  733.  
  734. (defun send-invisible (str)
  735.   "Read a string without echoing, and send it to the process running
  736. in the current buffer. A new-line is additionally sent. String is not 
  737. saved on comint input history list.
  738. Security bug: your string can still be temporarily recovered with
  739. \\[view-lossage]."
  740. ; (interactive (list (comint-read-noecho "Enter non-echoed text")))
  741.   (interactive "P") ; Defeat snooping via C-x esc
  742.   (let ((proc (get-buffer-process (current-buffer))))
  743.     (if (not proc) (error "Current buffer has no process")
  744.     (process-send-string proc
  745.                  (if (stringp str) str
  746.                  (comint-read-noecho "Enter non-echoed text")))
  747.     (process-send-string proc "\n"))))
  748.  
  749. ;;; Random input hackage
  750.  
  751. (defun comint-kill-output ()
  752.   "Kill all output from interpreter since last input."
  753.   (interactive)
  754.   (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
  755.     (kill-region comint-last-input-end pmark)
  756.     (goto-char pmark)    
  757.     (insert "*** output flushed ***\n")
  758.     (set-marker pmark (point))))
  759.  
  760. (defun comint-show-output ()
  761.   "Display start of this batch of interpreter output at top of window.
  762. Also put cursor there."
  763.   (interactive)
  764.   (goto-char comint-last-input-end)
  765.   (backward-char)
  766.   (beginning-of-line)
  767.   (set-window-start (selected-window) (point))
  768.   (end-of-line))
  769.  
  770. (defun comint-interrupt-subjob ()
  771.   "Interrupt the current subjob."
  772.   (interactive)
  773.   (interrupt-process nil t))
  774.  
  775. (defun comint-kill-subjob ()
  776.   "Send kill signal to the current subjob."
  777.   (interactive)
  778.   (kill-process nil t))
  779.  
  780. (defun comint-quit-subjob ()
  781.   "Send quit signal to the current subjob."
  782.   (interactive)
  783.   (quit-process nil t))
  784.  
  785. (defun comint-stop-subjob ()
  786.   "Stop the current subjob.
  787. WARNING: if there is no current subjob, you can end up suspending
  788. the top-level process running in the buffer. If you accidentally do
  789. this, use \\[comint-continue-subjob] to resume the process. (This
  790. is not a problem with most shells, since they ignore this signal.)"
  791.   (interactive)
  792.   (stop-process nil t))
  793.  
  794. (defun comint-continue-subjob ()
  795.   "Send CONT signal to process buffer's process group.
  796. Useful if you accidentally suspend the top-level process."
  797.   (interactive)
  798.   (continue-process nil t))
  799.  
  800. (defun comint-kill-input ()
  801.   "Kill all text from last stuff output by interpreter to point."
  802.   (interactive)
  803.   (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
  804.      (p-pos (marker-position pmark)))
  805.     (if (> (point) p-pos)
  806.     (kill-region pmark (point)))))
  807.  
  808. (defun comint-delchar-or-maybe-eof (arg)
  809.   "Delete ARG characters forward, or send an EOF to lisp if at end of buffer."
  810.   (interactive "p")
  811.   (if (eobp)
  812.       (process-send-eof)
  813.       (delete-char arg)))
  814.  
  815.  
  816.  
  817.  
  818. ;;; Support for source-file processing commands.
  819. ;;;============================================================================
  820. ;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
  821. ;;; commands that process files of source text (e.g. loading or compiling
  822. ;;; files). So the corresponding process-in-a-buffer modes have commands
  823. ;;; for doing this (e.g., lisp-load-file). The functions below are useful
  824. ;;; for defining these commands.
  825. ;;;
  826. ;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
  827. ;;; and Soar, in that they don't know anything about file extensions.
  828. ;;; So the compile/load interface gets the wrong default occasionally.
  829. ;;; The load-file/compile-file default mechanism could be smarter -- it
  830. ;;; doesn't know about the relationship between filename extensions and
  831. ;;; whether the file is source or executable. If you compile foo.lisp
  832. ;;; with compile-file, then the next load-file should use foo.bin for
  833. ;;; the default, not foo.lisp. This is tricky to do right, particularly
  834. ;;; because the extension for executable files varies so much (.o, .bin,
  835. ;;; .lbin, .mo, .vo, .ao, ...).
  836.  
  837.  
  838. ;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
  839. ;;; commands.
  840. ;;;
  841. ;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
  842. ;;; want to save the buffer before issuing any process requests to the command
  843. ;;; interpreter.
  844. ;;;
  845. ;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
  846. ;;; for the file to process.
  847.  
  848. ;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
  849. ;;;============================================================================
  850. ;;; This function computes the defaults for the load-file and compile-file
  851. ;;; commands for tea, soar, cmulisp, and cmuscheme modes. 
  852. ;;; 
  853. ;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
  854. ;;; source-file processing command. NIL if there hasn't been one yet.
  855. ;;; - SOURCE-MODES is a list used to determine what buffers contain source
  856. ;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
  857. ;;; Typically, (lisp-mode) or (scheme-mode).
  858. ;;; 
  859. ;;; If the command is given in a file buffer whose major modes is in
  860. ;;; SOURCE-MODES, then the the filename is the default file, and the
  861. ;;; file's directory is the default directory.
  862. ;;; 
  863. ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
  864. ;;; then the default directory & file are what was used in the last source-file
  865. ;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
  866. ;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
  867. ;;; is the cwd, with no default file. (\"no default file\" = nil)
  868. ;;; 
  869. ;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
  870. ;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
  871. ;;; for Soar programs, etc.
  872. ;;; 
  873. ;;; The function returns a pair: (default-directory . default-file).
  874.  
  875. (defun comint-source-default (previous-dir/file source-modes)
  876.   (cond ((and buffer-file-name (memq major-mode source-modes))
  877.      (cons (file-name-directory    buffer-file-name)
  878.            (file-name-nondirectory buffer-file-name)))
  879.     (previous-dir/file)
  880.     (t
  881.      (cons default-directory nil))))
  882.  
  883.  
  884. ;;; (COMINT-CHECK-SOURCE fname)
  885. ;;;============================================================================
  886. ;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
  887. ;;; process-in-a-buffer modes), this function can be called on the filename.
  888. ;;; If the file is loaded into a buffer, and the buffer is modified, the user
  889. ;;; is queried to see if he wants to save the buffer before proceeding with
  890. ;;; the load or compile.
  891.  
  892. (defun comint-check-source (fname)
  893.   (let ((buff (get-file-buffer fname)))
  894.     (if (and buff
  895.          (buffer-modified-p buff)
  896.          (y-or-n-p (format "Save buffer %s first? "
  897.                    (buffer-name buff))))
  898.     ;; save BUFF.
  899.     (let ((old-buffer (current-buffer)))
  900.       (set-buffer buff)
  901.       (save-buffer)
  902.       (set-buffer old-buffer)))))
  903.  
  904.  
  905. ;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
  906. ;;;============================================================================
  907. ;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
  908. ;;; commands that process source files (like loading or compiling a file).
  909. ;;; It prompts for the filename, provides a default, if there is one,
  910. ;;; and returns the result filename.
  911. ;;; 
  912. ;;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
  913. ;;; 
  914. ;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
  915. ;;; from the last source processing command.  SOURCE-MODES is a list of major
  916. ;;; modes used to determine what file buffers contain source files.  (These
  917. ;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
  918. ;;; then the filename reader will only accept a file that exists.
  919. ;;; 
  920. ;;; A typical use:
  921. ;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
  922. ;;;                                 "\\.lisp\\'" t))
  923.  
  924. (defun comint-get-source (prompt prev-dir/file source-regexp mustmatch-p)
  925.   (let* ((def (comint-source-default prev-dir/file source-regexp))
  926.      (defdir  (car def))
  927.      (deffile (cdr def))
  928.      (ans (read-file-name (if deffile (format "%s(default %s) "
  929.                           prompt    deffile)
  930.                   prompt)
  931.                   defdir
  932.                   (concat defdir deffile)
  933.                   mustmatch-p)))
  934.     (list (expand-file-name (substitute-in-file-name ans)))))
  935.  
  936.  
  937. ;;; Filename completion in a buffer
  938. ;;; ===========================================================================
  939. ;;; Useful completion functions, courtesy of the Ergo group.
  940. ;;; M-<Tab> will complete the filename at the cursor as much as possible
  941. ;;; M-? will display a list of completions in the help buffer.
  942.  
  943. ;;; Three commands:
  944. ;;; comint-dynamic-complete        Complete filename at point.
  945. ;;; comint-dynamic-list-completions    List completions in help buffer.
  946. ;;; comint-replace-by-expanded-filename    Expand and complete filename at point;
  947. ;;;                    replace with expanded/completed name.
  948.  
  949. ;;; These are not installed in the comint-mode keymap. But they are
  950. ;;; available for people who want them. Shell-mode installs them:
  951. ;;; (define-key cmushell-mode-map "\M-\t" 'comint-dynamic-complete)
  952. ;;; (define-key cmushell-mode-map "\M-?"  'comint-dynamic-list-completions)))
  953. ;;;
  954. ;;; Commands like this are fine things to put in load hooks if you
  955. ;;; want them present in specific modes. Example:
  956. ;;; (setq cmushell-load-hook
  957. ;;;       '((lambda () (define-key lisp-mode-map "\M-\t"
  958. ;;;                   'comint-replace-by-expanded-filename))))
  959. ;;;          
  960.  
  961.  
  962. (defun comint-match-partial-pathname ()
  963.   "Returns the string of an existing filename or causes and error."
  964.   (if (save-excursion (backward-char 1) (looking-at "\\s ")) ""
  965.       (save-excursion
  966.     (re-search-backward "[^~/A-Za-z0-9---_.$#,]+")
  967.     (re-search-forward "[~/A-Za-z0-9---_.$#,]+")
  968.     (substitute-in-file-name 
  969.       (buffer-substring (match-beginning 0) (match-end 0))))))
  970.  
  971. (defun comint-replace-by-expanded-filename ()
  972.   "Replace filename at point with expanded, completed name"
  973.   (interactive)
  974.   (let* ((pathname (comint-match-partial-pathname))
  975.      (pathdir (file-name-directory pathname))
  976.      (pathnondir (file-name-nondirectory pathname))
  977.      (completion (file-name-completion  pathnondir
  978.                        (or pathdir default-directory))))
  979.     (cond ((null completion)
  980.        (message "No completions of %s." pathname)
  981.        (ding))
  982.       ((eql completion t)
  983.        (message "Unique completion."))
  984.       (t                ; this means a string was returned.
  985.        (delete-region (match-beginning 0) (match-end 0))
  986.        (insert pathdir completion)))))
  987.  
  988. (defun comint-dynamic-complete ()
  989.   "Dynamically complete the filename at point."
  990.   (interactive)
  991.   (let* ((pathname (comint-match-partial-pathname))
  992.      (pathdir (file-name-directory pathname))
  993.      (pathnondir (file-name-nondirectory pathname))
  994.      (completion (file-name-completion  pathnondir
  995.                        (or pathdir default-directory))))
  996.     (cond ((null completion)
  997.        (message "No completions of %s." pathname)
  998.        (ding))
  999.       ((eql completion t)
  1000.        (message "Unique completion."))
  1001.       (t                ; this means a string was returned.
  1002.        (insert (substring completion (length pathnondir)))))))
  1003.  
  1004. (defun comint-dynamic-list-completions ()
  1005.   "List in help buffer all possible completions of the filename at point."
  1006.   (interactive)
  1007.   (let* ((pathname (comint-match-partial-pathname))
  1008.      (pathdir (file-name-directory pathname))
  1009.      (pathnondir (file-name-nondirectory pathname))
  1010.      (completions
  1011.       (file-name-all-completions pathnondir
  1012.                      (or pathdir default-directory))))
  1013.     (cond ((null completions)
  1014.        (message "No completions of %s." pathname)
  1015.        (ding))
  1016.       (t (with-output-to-temp-buffer "*Help*"
  1017.            (display-completion-list completions))))))
  1018.  
  1019. ; Ergo bindings
  1020. ; (global-set-key "\M-\t" 'comint-replace-by-expanded-filename)
  1021. ; (global-set-key "\M-?" 'comint-dynamic-list-completions)
  1022. ; (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
  1023.  
  1024. ;;; Log the user, so I know who's using the package during the beta test 
  1025. ;;; period. This just inserts the user's name and current time into a 
  1026. ;;; central file.
  1027. (defun comint-log-user ()
  1028.   (interactive)
  1029.   (if (file-writable-p "/afs/cs/user/shivers/lib/emacs/logdir/comint.log")
  1030.       (let ((u (getenv "USER"))
  1031.         (old-buff (current-buffer)))
  1032.     (message "logging user in beta test database...")
  1033.     (find-file "/afs/cs/user/shivers/lib/emacs/logdir/comint.log")
  1034.     (cond ((search-forward u nil 'to-end)
  1035.            (search-forward "| ")
  1036.            (kill-line 1))
  1037.           (t (insert (format "%s\t%s\t| " u (current-time-string)))))
  1038.     (insert (format "%s\n" (current-time-string)))
  1039.     (let ((make-backup-files nil)) (save-buffer))
  1040.     (kill-buffer (current-buffer))
  1041.     (set-buffer old-buff))))
  1042. (comint-log-user)
  1043.  
  1044.  
  1045. ;;; Converting process modes to use comint mode
  1046. ;;; ===========================================================================
  1047. ;;; Several onu packages (tex-mode, background, dbx, gdb, kermit, prolog, 
  1048. ;;; telnet are some) use the shell package as clients. Most of them would
  1049. ;;; be better off using the comint package, but they predate it. 
  1050. ;;;
  1051. ;;; Altering these packages to use comint mode should greatly
  1052. ;;; improve their functionality, and is fairly easy.
  1053. ;;; 
  1054. ;;; Renaming variables
  1055. ;;; Most of the work is renaming variables and functions. These are the common
  1056. ;;; ones:
  1057. ;;; Local variables:
  1058. ;;;     last-input-end        comint-last-input-end
  1059. ;;;    last-input-start    <unnecessary>
  1060. ;;;    shell-prompt-pattern    comint-prompt-regexp
  1061. ;;;     shell-set-directory-error-hook <no equivalent>
  1062. ;;; Miscellaneous:
  1063. ;;;    shell-set-directory    <unnecessary>
  1064. ;;;     shell-mode-map        comint-mode-map
  1065. ;;; Commands:
  1066. ;;;    shell-send-input    comint-send-input
  1067. ;;;    shell-send-eof        comint-delchar-or-maybe-eof
  1068. ;;;     kill-shell-input    comint-kill-input
  1069. ;;;    interrupt-shell-subjob    comint-interrupt-subjob
  1070. ;;;    stop-shell-subjob    comint-stop-subjob
  1071. ;;;    quit-shell-subjob    comint-quit-subjob
  1072. ;;;    kill-shell-subjob    comint-kill-subjob
  1073. ;;;    kill-output-from-shell    comint-kill-output
  1074. ;;;    show-output-from-shell    comint-show-output
  1075. ;;;    copy-last-shell-input    Use comint-previous-input/comint-next-input
  1076. ;;;
  1077. ;;; LAST-INPUT-START is no longer necessary because inputs are stored on the
  1078. ;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken
  1079. ;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel.
  1080. ;;; Comint mode does not provide functionality equivalent to 
  1081. ;;; shell-set-directory-error-hook; it is gone.
  1082. ;;; 
  1083. ;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
  1084. ;;; *not* create the comint-mode local variables in your foo-mode function.
  1085. ;;; This is not modular.  Instead, call comint-mode, and let *it* create the
  1086. ;;; necessary comint-specific local variables. Then create the
  1087. ;;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
  1088. ;;; be foo-mode-map, and it's mode to be foo-mode.  Set the comint-mode hooks
  1089. ;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel,
  1090. ;;; comint-get-old-input) that need to be different from the defaults.  Call
  1091. ;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
  1092. ;;; comint-mode will take care of it. The following example, from cmushell.el,
  1093. ;;; is typical:
  1094. ;;; 
  1095. ;;; (defun shell-mode ()
  1096. ;;;   (interactive)
  1097. ;;;   (comint-mode)
  1098. ;;;   (setq comint-prompt-regexp shell-prompt-pattern)
  1099. ;;;   (setq major-mode 'shell-mode)
  1100. ;;;   (setq mode-name "Shell")
  1101. ;;;   (cond ((not shell-mode-map)
  1102. ;;;          (setq shell-mode-map (full-copy-sparse-keymap comint-mode-map))
  1103. ;;;          (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
  1104. ;;;          (define-key shell-mode-map "\M-?"
  1105. ;;;                      'comint-dynamic-list-completions)))
  1106. ;;;   (use-local-map shell-mode-map)
  1107. ;;;   (make-local-variable 'shell-directory-stack)
  1108. ;;;   (setq shell-directory-stack nil)
  1109. ;;;   (setq comint-input-sentinel 'shell-directory-tracker)
  1110. ;;;   (run-hooks 'shell-mode-hook))
  1111. ;;;
  1112. ;;;
  1113. ;;; Note that make-comint is different from make-shell in that it
  1114. ;;; doesn't have a default program argument. If you give make-shell
  1115. ;;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
  1116. ;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
  1117. ;;; of NIL, it barfs. Adjust your code accordingly...
  1118. ;;;
  1119.  
  1120. ;;; Do the user's customisation...
  1121.  
  1122. (defvar comint-load-hook nil
  1123.   "This hook is run when comint is loaded in.
  1124. This is a good place to put keybindings.")
  1125.     
  1126. (run-hooks 'comint-load-hook)
  1127. ;-- 
  1128.  
  1129.